home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue66 / Shell / MakeFileAssocU.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-11-14  |  2.5 KB  |  84 lines
  1. unit MakeFileAssocU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     procedure Button1Click(Sender: TObject);
  13.   private
  14.     { Private declarations }
  15.   public
  16.     { Public declarations }
  17.   end;
  18.  
  19. var
  20.   Form1: TForm1;
  21.  
  22. implementation
  23.  
  24. {$R *.DFM}
  25.  
  26. uses
  27.   ComObj, ShlObj;
  28.  
  29. procedure MakeAssoc(
  30.   const FileExt, FileClass, Description, DefaultIcon: String;
  31.   AlwaysShowExt, QuickView: Boolean);
  32. begin
  33.   if (Length(FileExt) = 0) or (FileExt[1] <> '.') then
  34.     raise Exception.Create('Invalid file extension');
  35.   CreateRegKey(FileExt, '', FileClass);
  36.   CreateRegKey(FileClass, '', Description);
  37.   if DefaultIcon <> '' then
  38.     CreateRegKey(FileClass + '\DefaultIcon', '', DefaultIcon);
  39.   if AlwaysShowExt then
  40.     CreateRegKey(FileClass, 'AlwaysShowExt', '');
  41.   if QuickView then
  42.     CreateRegKey(FileClass + '\QuickView', '', '*');
  43.   SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
  44. end;
  45.  
  46. procedure MakeAssocVerb(
  47.   const FileExt, Verb, VerbCaption, VerbCommand: String;
  48.   UseDDE: Boolean;
  49.   const Service, Topic, Macro, MacroNotRunning: String);
  50. var
  51.   FileClass: String;
  52. begin
  53.   if (Length(FileExt) = 0) or (FileExt[1] <> '.') then
  54.     raise Exception.Create('Invalid file extension');
  55.   FileClass := GetRegStringValue(FileExt, '');
  56.   if FileClass = '' then
  57.     raise Exception.Create('File extension not registered');
  58.   CreateRegKey(FileClass + '\shell\' + Verb, '', VerbCaption);
  59.   CreateRegKey(FileClass + '\shell\' + Verb + '\command', '', VerbCommand);
  60.   if UseDDE then
  61.   begin
  62.     CreateRegKey(FileClass + '\shell\' + Verb + '\ddeexec', '', Macro);
  63.     CreateRegKey(FileClass + '\shell\' + Verb + '\ddeexec\Application', '', Service);
  64.     CreateRegKey(FileClass + '\shell\' + Verb + '\ddeexec\Topic', '', Topic);
  65.     if MacroNotRunning <> '' then
  66.       CreateRegKey(FileClass + '\shell\' + Verb + '\ddeexec\ifexec', '', MacroNotRunning);
  67.   end;
  68.   SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
  69. end;
  70.  
  71. procedure TForm1.Button1Click(Sender: TObject);
  72. begin
  73.   MakeAssoc('.DC', 'DC_File', 'Delphi Clinic File',
  74.     'D:\Temp\EXE Bin\FileAssoc.exe,0', True, True);
  75.   MakeAssocVerb('.DC', 'open', '', '"D:\Temp\EXE Bin\FileAssoc.exe" %1',
  76.     True, 'FileAssoc', 'System', '[open("%1")]', '');
  77.   MakeAssocVerb('.DC', 'print', '', '"D:\Temp\EXE Bin\FileAssoc.exe" %1',
  78.     True, 'FileAssoc', 'System',
  79.     '[open("%1")][print()][close()]',
  80.     '[open("%1")][print()][exit()]');
  81. end;
  82.  
  83. end.
  84.